perm filename COLL.SAI[PIC,HE]1 blob sn#428028 filedate 1979-03-05 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry
C00015 ENDMK
CāŠ—;
entry;
begin  "coll"

  comment
    Routine SAIL definitions, standard constants, and frequent
    REQUIREing of files are in the following file:;

        require  "define.sai"  source!file;

  ! Starting date of this file: August 2, 1978.
    This module considers collinears as a data structure as
    defined in
                coll.data
    and implements a set of procedures acting on the data.;

        define  colldata = "internal";
        require  "coll.data"  source!file;

  ! Separately built procedures for graphics and associated
    ornamentation are declared in;

        require  "grafix.dcl"  source!file;

  ! The picture to be worked on is obtained externally by the
    program that interfaces with the user, viz.
		colluse.sai,
    and is a parameter for this module.;

        external  string  picture;

  ! Headers are stored in;

        safe  integer  array  header[0:hdrl-1];

  ! COmposition of the header;
	DEfine  cszcoll = "header[31]",
		rszcoll = "header[32]",
          	collno = "headeR[33]";

  ! The file containing colls is referred to by the;

	integer  collfile;

  ! The internal procedures hide the implementation details.
    Other, non-internal, procedures are an effort at 
    structured programming (!).
    All DEFINEs in capitals are compile-time variables used
    essentially for generating debugging code. In fact, the
    debugging code is also in capitals.;

        DEFINE  COLLMKCHECK = "TRUE";

  internal  simple  procedure  collreset;
  swdptr(collfile,hdrl);

  internal  simple  procedure  colldisplay;
  begin
  integer  r, c, deg, size;  real  half;

  ! This prcedure displays a coll whose details are in the
    data structure
		coll:   [pcoll];

    pctr(0);  initt(450);
    size := cszcoll;  if  rszcoll > size  then  size := rszcoll;
    vwindo(0.0,1.41*size,-1.06*size,1.06*size);
    deg := coll:theta[pcoll] + 90;  half := coll:w[pcoll]/2;
    r := half*cosd(deg);  c := half*sind(deg);
    movea(1.0*(coll:c1[pcoll]+c),-1.0*(coll:r1[pcoll]+r));
    drawa(1.0*(coll:c2[pcoll]+c),-1.0*(coll:r2[pcoll]+r));
    drawa(1.0*(coll:c2[pcoll]-c),-1.0*(coll:r2[pcoll]-r));
    drawa(1.0*(coll:c1[pcoll]-c),-1.0*(coll:r1[pcoll]-r));
    drawa(1.0*(coll:c1[pcoll]+c),-1.0*(coll:r1[pcoll]+r));
    movea(1.0*(coll:c1[pcoll]),-1.0*(coll:r1[pcoll]));
    drawa(1.0*(coll:c2[pcoll]),-1.0*(coll:r2[pcoll]));
    endpct;
  end;  "colldisplay"

  internal  simple  procedure  collout;
  begin

  ! Procedure to assign an id to a newly-made coll and store
    it on the disk. Id's are assigned in the natural order.;

    collno := collno + 1;
    coll:name[pcoll] := collno;
    arryout(collfile,coll:name[pcoll],collsz);
    IFC  COLLMKCHECK  THENC
    COLLDISPLAY;
    ENDC;
  end;

  internal  simple  procedure  collget;
  begin

  ! Procedure to get the next coll from the disk file. This
    does not, repeat does not, bother about the pointer to the
    file. Simply the next. See the 
		procrdure  collin(...);

    arryin(collfile,coll:name[pcoll],COLLsz);
  end;

  internal  simple  procedure  collin(integer id);
  begin

  ! Simulation of direct access into the file of collinears.;

    swdptr(collfile,hdrl+(id-1)*collsz);
    arryin(collfile,coll:name[pcoll],COLLsz);
  end;

  internal  simple  procedure  collopen;
  begin

  ! Procedure  to open a new file for storing collinears on
    the disk. It also initialises the header, allocates
    data space for storing a coll (as a record).;

    collfile := openfile(picture & ".coll","wc");
    swdptr(collfile,hdrl);
    pcoll := new!record(coll);
    header[0] := hdrl;  header[1] := 36;
    header[2] := collsz;  header[3] := collsz;
    header[5] := '1000001;  collno := 0;
  end;

  internal  simple  procedure  rdchdr;
  begin

  ! procedure  to read off the header picture size and the
    number of collinears.;

    swdptr(collfile,0);  arryin(collfile,header[0],hdrl);
    PRint(picture," is ",rszcoll," x ",cszcoll,crlf);
    print(" No of collinears ",collno,crlf);
  end;

  internal  simple  procedure  wtchdr;
  begin
  ! Procedure to write the header on to .coll file.;

    header[31] := cszcoll;  header[32] := RSZCOLL;
    header[33] := collno;  header[4] := collsz * collno;
    swdptr(collfile,0);  arryout(collfile,header[0],hdrl);
    print(picture & ".coll" & ": header written.",crlf);
  end;

  internal  simple  procedure  tychdr;
  begin

  ! Type relevant information from the header of a .coll file.;

    rdchdr;
    print(" Info about ",picture & ".coll",crlf);
    print(" Picture size: ",rszcoll," x ",cszcoll,crlf);
    print(" No of collinears: ",collno);
    
  end;

  internal  simple  procedure  collpicture;
  begin
  integer  k, r, c, deg, size;  real  half;

  ! Display of the whole picture  in terms of its collinears.
    Contrast this with the procedure which displays only one
    collinear.;

    pctr(0);  initt(450);
    size := cszcoll;  if  rszcoll > size  then  size := rszcoll;
    vwindo(0.0,1.41*size,-1.06*size,1.06*size);
    k := 0;
    while  k < collno  do
    begin
      collget;  k := k + 1;
      deg := coll:theta[pcoll] + 90;  half := coll:w[pcoll]/2;
      r := half*cosd(deg);  c := half*sind(deg);
      movea(1.0*(coll:c1[pcoll]+c),-1.0*(coll:r1[pcoll]+r));
      drawa(1.0*(coll:c2[pcoll]+c),-1.0*(coll:r2[pcoll]+r));
      drawa(1.0*(coll:c2[pcoll]-c),-1.0*(coll:r2[pcoll]-r));
      drawa(1.0*(coll:c1[pcoll]-c),-1.0*(coll:r1[pcoll]-r));
      drawa(1.0*(coll:c1[pcoll]+c),-1.0*(coll:r1[pcoll]+r));
      movea(1.0*(coll:c1[pcoll]),-1.0*(coll:r1[pcoll]));
      drawa(1.0*(coll:c2[pcoll]),-1.0*(coll:r2[pcoll]));
    end;
    endpct;
  end;  "collpicture"

  internal  simple  procedure  collclose;
  begin

  ! Closing of .coll file after outputting all the collinears.;

  cfile(collfile);
    print(picture & ".coll" & ": closed.",crlf);  BEll;
  end;

  internal  simple  procedure  collptr;
  pcoll := new!record(coll);

  internal  simple  procedure  collrdopen;
  begin

  ! Setting up of the .coll file to read off the collinears.;

    collfile := openfile(picture & ".coll","rc");
    collptr;  arryin(collfile,header[0],hdrl);
  end;

  internal  simple  procedure  colltty(integer id);
  begin
  boolean  yes;

  ! Typing out of a collinear on the teletype. For purposes
    of examination of data. Useful as an interface.;

    swdptr(collfile,(id-1)*collsz+hdrl);  collget;
    print(" Name: ",coll:name[pcoll],crlf);
    print(coll:r1[pcoll],",",coll:c1[pcoll]," to ",coll:r2[pcoll],",",coll:c2[Pcoll],crlf);
    print("length: ",coll:l[pcoll]," width: ",coll:w[pcoll]," angle: ",coll:theta[pcoll],crlf);
    print(" Major component: ",coll:major[pcoll]," and is made of ",coll:madeof[pcoll],"components.",crlf);
    bprmpt(" Display ?",yes);  if  yes  then  colldisplay;
  end;
  ! Setting up of picture size into .coll file header.;


  internal  simple  procedure  collsize(integer r, c, n);
  begin
    cszcoll := c;  rszcoll := r;  collno := n;
  end;


  internal  simple  procedure  colltestinfo;
  begin
  ! Procedure to produce test information.;
  integer  c;
    collrdopen;

    print(" Listing of major components of colls.",crlf);
    print(" collid   major ",crlf);
    for  c := 1 step 1 until collno  do
    begin
      collget;
      print(c," ",coll:name[pcoll],"  ",coll:major[pcoll],crlf);
    end;
  end;

  internal  simple  procedure  collfree;
  cfile(collfile);

  internal  simple  integer  procedure  noofcolls;
  return(collno);

end